perm filename FILLXG.OLD[XX,LCS] blob sn#206563 filedate 1976-03-22 generic text, type T, neo UTF8
00100		TITLE FILL
00200		ENTRY FILLER,LINES,PLOTS,NOIR
00300		EXTERNAL DST,PLTR,DPY,.COMM.,ROFF,XRN,SQRT,PLOT
00500		DEFINE FLOAT(N)
00600	   <	TLC N,232000
00700		FADR N,N   >
00800		DEFINE FIXX(N)
00900	  <	JUMPGE	N,.+5
01000		MOVNS	N
01100		FIX 	N,233000    
01200		MOVNS	N
01300		CAIA
01400		FIX	N,233000 >	; TO FIX IT LIKE 'IFIX' DOES.
01500	
01600		KK←2 ↔ L←3 ↔ LE←4 ↔ T←5 ↔ J←1
01700		RL←6 ↔ RJ←7 ↔ B←0 ↔ H←11 ↔ JK←10
01800		HG←12 ↔ D←13 ↔ AL←14 ↔ JJ←15
01900	
02000					;	SUBROUTINE FILLER(Q,M)
02100	FILLER:	0
02200		MOVEM 16,SV16#
02300		HRRZ J,(16)
02400		HRRZM J,SVQ#
02500		HRRZ T,@1(16)
02600		HRRZM T,SVM#		;	KK=NE(1)
02700		HRRZ KK,2(J)
02800		ADDI KK,-1(J)
02900					;	DO 4 K=2,KK
03000		HRRZI L,2(J)
03100					;	IF(NE(K).NE.3)GO TO 11
03200	L4:	ADDI L,3
03300		HRRZ T,(L)
03400	L11:	SETZM (L)
03500		CAIN T,3
03600					;	NE(K)=-1
03700	      	SETOM (L)
03800					;	GO TO 4
03900					; 11	NE(K)=0
04000					; 4	CONTINUE
04100		CAIGE L,(KK)
04200		JRST L4
04300					;	RLFT=10000
04400		MOVE RL,[=10000.0]
04500					;	RT=-10000
04600		MOVN RJ,[=10000.0]
04700					;	B=RT
04800		MOVE B,RJ
04900					;	DO 12 K=1,KK
05000		HRRZI L,-3(J)
05100					;	H=IFIX(Q(K))
05200	L12:	ADDI L,3
05300		MOVE H,(L)
05400		FIXX(H)
05500		FLOAT(H)
05600					;	IF(H.LT.RLFT)RLFT=H
05700		CAMGE H,RL
05800		MOVE RL,H
05900	
06000					;	IF(H.GT.RT)RT=H
06100		CAMLE H,RJ
06200		MOVE RJ,H
06300					;	IF(H.EQ.B)NE(K)=-1
06400		CAMN H,B
06500		SETOM 2(L)
06600					;	B=H
06700		MOVE B,H
06800					;	Q(K)=H
06900		MOVEM H,(L)
07000					; 12    R(K)=IFIX(R(K))
07100		MOVE T,1(L)
07200		FIXX(T)
07300		FLOAT(T)
07400		MOVEM T,1(L)
07500		CAIGE L,-2(KK)
07600		JRST L12
07700					;	NE(KK+1)=-1
07800		SETOM 3(KK)
07900	
08000					;	LRT=RT
08100		FIXX(RJ)
08200		MOVEM RJ,LRT#
08300					;	JA=3
08400		HRRZI T,3
08500		HRRZM T,JA#
08600	
08700	
08800					; 124   LEFT=RLFT
08900	L124:	MOVE LE,RL
09000		FIXX(LE)
09100					; 51    J=LEFT
09200	L51:	MOVE J,LE
09300					; 42    RJ=J+.001
09400	L42:	MOVE RJ,J
09500		FLOAT(RJ)
09600		FADR RJ,[=0.001]
09700					;	JCONT=0
09800		SETZM JCONT#
09900					;	LEFT=J
10000		MOVE LE,J
10100	
10200					;	JJ=-1
10300		SETO JJ,
10400					;	ALT=-10000.
10500		MOVN AL,[=10000.0]
10600					; 200   DO 45 L=2,KK
10700		HRRZ L,SVQ
10800	L45:	ADDI L,3
10900		CAILE L,-2(KK)
11000		JRST L455
11100					;	IF(NE(L).NE.0)GO TO 45
11200		SKIPE 2(L)
11300		JRST L45
11400					;	IF(MISS(L,RJ,Q))GO TO 45
11500		CAML RJ,-3(L)
11600		JRST L201
11700		CAMLE RJ,(L)
11800		JRST L202
11900	L201:	CAMGE RJ,(L)
12000		CAMG RJ,-3(L)
12100		JRST L45
12200					;	H=HGHT(L,RJ,Q,R)
12300	L202:	MOVE H,-2(L)
12400		CAMN H,1(L)
12500		JRST RET
12600		MOVNS H
12700		FADR H,1(L)
12800		MOVE D,-3(L)
12900		MOVNS T,D
13000		FADR T,RJ
13100		FADR D,(L)
13200		FMPR H,T
13300		FDVR H,D
13400		FADR H,-2(L)
13500					;	IF(H.LT.ALT)GO TO 45
13600	RET:	CAMGE H,AL
13700		JRST L45
13800	
13900					;	ALT=H
14000		MOVE AL,H
14100					;	JJ=L
14200		HRRZI JJ,(L)
14300					; 45    CONTINUE
14400		JRST L45
14500					;	IF(JJ)GO TO 43
14600	L455:	JUMPL JJ,L43
14700					;	JCONT=-1
14800		SETOM JCONT
14900					;	LEFT=J
15000		MOVE LE,J
15100					; 46    JA=3
15200	L46:	HRRZI T,3
15300		HRRZM T,JA
15400					;	JORD=-1
15500		SETOM JORD#
15600					; 52    KN=Q(JJ)
15700	L52:	MOVE T,(JJ)
15800		FIXX(T)
15900		MOVEM T,KN#
16000					;	KL=Q(JJ-1)
16100		MOVE T,-3(JJ)
16200		FIXX(T)
16300	
16400		MOVEM T,KL#
16500					;	IF(KN.LT.KL)KN=KL
16600		CAMLE T,KN
16700		MOVEM T,KN
16800					; 50    I=J
16900	L50:	MOVEM J,I#
17000					; 102   RJ=I+.01
17100	L102:	MOVE RJ,I
17200		FLOAT(RJ)
17300		FADR RJ,[=0.1]	;6/11/75 ←←**↑↑ WAS 0.01 -- CHECK TIGHT CASES!!
17400					;	ALT=HGHT(JJ,RJ,Q,R)
17500		MOVE AL,-2(JJ)
17600		CAMN AL,1(JJ)
17700		JRST RET2
17800		MOVNS AL
17900		FADR AL,1(JJ)
18000		MOVE D,-3(JJ)
18100		MOVNS T,D
18200		FADR T,RJ
18300		FADR D,(JJ)
18400		FMPR AL,T
18500		FDVR AL,D
18600		FADR AL,-2(JJ)
18700					;	B=-10000
18800	RET2:	MOVN B,[=10000.0]
18900					;	JK=-1
19000		SETO JK,
19100					;	XALT=ALT+.001
19200		MOVE T,AL
19300		FADR T,[=0.001]
19400		MOVEM T,XALT#
19500	
19600					;	ZALT=ALT
19700		MOVEM AL,ZALT#
19800					; 400   DO 47 L=2,KK
19900		MOVE L,SVQ
20000	L47:	ADDI L,3
20100		CAILE L,-2(KK)
20200		JRST L477
20300				;	IF(L.EQ.JJ.OR.MISS(L,RJ,Q).OR.NE(L).LT.0)GO TO 47
20400		CAME L,JJ
20500		SKIPGE 2(L)
20600		JRST L47
20700		CAML RJ,-3(L)
20800		JRST L475
20900		CAMLE RJ,(L)
21000		JRST L476
21100	L475:	CAMGE RJ,(L)
21200		CAMG RJ,-3(L)
21300		JRST L47
21400					;	H=HGHT(L,RJ,Q,R)
21500	L476:	MOVE H,-2(L)
21600		CAMN H,1(L)
21700		JRST RET3
21800		MOVNS H
21900		FADR H,1(L)
22000		MOVE D,-3(L)
22100		MOVNS T,D
22200		FADR T,RJ
22300		FADR D,(L)
22400		FMPR H,T
22500		FDVR H,D
22600		FADR H,-2(L)
22700					;	IF(H.GT.XALT)GO TO 47
22800	RET3:	CAMG H,XALT
22900	
23000					;	IF(H.LE.B)GO TO 47
23100		CAMG H,B
23200		JRST L47
23300					;	B=H
23400		MOVE B,H
23500					;	JK=L
23600		HRRZI JK,(L)
23700					; 47    CONTINUE
23800		JRST L47
23900					;	IF(JK)GO TO 48
24000	L477:	JUMPL JK,L48
24100					;	300   IF(ZALT-B.GT..001.OR.I.NE.J)GO TO 59
24200		MOVN T,B
24300		FADR T,ZALT
24400		CAMG T,[=0.001]
24500		CAME J,I
24600		JRST L59
24700					;	JX=Q(JK)
24800		MOVE T,(JK)
24900		FIXX(T)
25000					;	IF(JX.GT.KN)GO TO 60
25100		CAMLE T,KN
25200		JRST L60
25300					;	JX=Q(JK-1)
25400		MOVE T,-3(JK)
25500		FIXX(T)
25600					;	IF(JX.LT.KN)GO TO 59
25700		CAMGE T,KN
25800		JRST L59
25900					; 60    L=JJ
26000	L60:	MOVE L,JJ
26100					;	JJ=JK
26200		MOVE JJ,JK
26300					;	JK=L
26400		MOVE JK,L
26500					;	KN=JX
26600		MOVEM T,KN
26700	
26800					; 59    IF(ALT-B.LT.2)GO TO 62
26900	L59:	MOVN T,B
27000		FADR T,AL
27100		CAMGE T,[=2.0]
27200		JRST L62
27300					;	ALT=ALT-1
27400		HRLZI T,576400
27500		FADR AL,T
27600					;	B=B+1
27700		HRLZI T,201400
27800		FADR B,T
27900					; 62    IF(JORD)GO TO 103
28000	L62:	SKIPGE JORD
28100		JRST L103
28200					;	H=B
28300		MOVE H,B
28400					;	B=ALT
28500		MOVE B,AL
28600					;	ALT=H
28700		MOVE AL,H
28800					;	IF(JK.NE.NK.AND.ABS(ALT-B).GT.5.)JA=3
28900	
29000		CAMN JK,NK#
29100		JRST L103
29200		MOVN T,B
29300		FADR T,AL
29400		SKIPGE T
29500		MOVNS T
29600		CAMG T,[5.0]
29700		JRST L103
29800		HRRZI T,3
29900		HRRZM T,JA
30000					; 103   CALL LINES(RJ,ALT,JA)
30100	L103:	MOVEM RJ,SVRJ#
30200		MOVEM AL,SVAL#
30300		MOVEM B,SVB#
30400		HRRZI 16,SVAC
30500		BLT 16,SVAC+15
30600		JSA 16,LINES
30700		JUMP SVRJ
30800		JUMP SVAL
30900		JUMP JA
31000					; 100   CALL LINES(RJ,B,2)	
31100		JSA 16,LINES
31200		JUMP SVRJ
31300		JUMP SVB 
31400		JUMP [2]
31500		HRLZI 16,SVAC
31600		BLT 16,15
31700					;	NK=JK
31800		MOVEM JK,NK
31900	
32000					;	JORD=-JORD
32100		MOVNS JORD
32200					;	NE(JK)=1
32300		HRRZI T,1
32400		HRRZM T,2(JK)
32500					;	NE(JJ)=-1
32600		SETOM 2(JJ)
32700					;	JA=2
32800		HRRZI T,2
32900		HRRZM T,JA
33000					;	I=I+M
33100		MOVE T,SVM
33200		ADDB T,I
33300					;	IF(I.LT.KN)GO TO 102
33400		CAMGE T,KN
33500		JRST L102
33600					;	L=1
33700		HRRZI L,3
33800					;	IF(KN.EQ.KL)L=-1
33900		MOVE T,KN
34000		CAMN T,KL
34100		HRROI L,-3
34200					;	JJ=JJ+L
34300		ADD JJ,L
34400					;	J=0
34500		SETZ J,
34600					;	IF(L)J=-1
34700		SKIPGE L
34800		HRROI J,-3
34900			;	IF(KN+M.GT.Q(JJ+J).OR.JJ.GT.KK.OR.NE(JJ).NE.0)GO TO 124
35000		SKIPN 2(JJ)
35100		CAILE JJ,-2(KK)
35200		JRST L124
35300		ADD T,SVM
35400		FLOAT(T)
35500		HRRZI HG,(JJ)
35600		ADD HG,J
35700		CAMLE T,(HG)
35800		JRST L124
35900					;	J=I
36000		MOVE J,I
36100					;	GO TO 52
36200		JRST L52
36300					; 48    JA=3
36400	L48:	HRRZI T,3
36500		HRRZM T,JA
36600					; 43    J=LEFT+M
36700	L43:	MOVE J,LE
36800		ADD J,SVM
36900					;	IF(J.LE.LRT)GO TO 42
37000		CAMG J,LRT
37100		JRST L42
37200					;	IF(JCONT)GO TO 51
37300		SKIPGE JCONT
37400		JRST L51		;	END
37500		MOVE 16,SV16
37600		JRA 16,2(16)
37700	SVAC:	BLOCK 16
37800	
37900			;	SUBROUTINE LINES(A,B,L)
38000			;	COMMON/DST/BB,CC
38100	   		;	COMMON /SIZ/RSZ,JCEN,KCEN /FL/IC,NZ,NX,RZ,XGP
38200			;	COMMON/DL/IXRX,SAVER,AA /PLTR/IPLT,RHT,DIS
38300			;	COMMON R2,JA,CENTR,JB,RJQ(20),JQ(20)
38400			;	COMMON/DPY/JJ(4000),WDS(250),MEDIT,IGO
38500			;	EQUIVALENCE (ITOP,JJ(3999)),(IBOT,JJ(4000))
38600			;	1,(JJ2,JJ(2))
38700			;	DATA BB/.008/,CC/3.5/
38800	 		;C  SET XGP TO 1200.0 FOR MARGIN IN XEROX COPIES
38900		
39000		M←2 ↔ NZ←3 ↔ K←4
39100	
39200	LINES:	0
39300				;	GO TO 23
39400		JRST L23
39500				;22	IF(JQ(1).NE.0)GO TO 23
39600	L22:	SKIPE PLTR+=27
39700		JRST L23
39800				;	IF(CC.EQ.1000)GO TO 23
39900		MOVSI T,212764
40000		CAMN T,DST+1
40100		JRST L23
40200				;	B=B*(CC-BB*ABS(A))
40300		MOVE T,@(16)
40400		MOVMS	T
40500		FMPR T,DST
40600		FSBR T,DST+1
40700		FMPRM T,@1(16)
40800		MOVNS @1(16)
40900				;23	IF(IPLT)GO TO 2
41000	L23:	SKIPGE PLTR
41100	;;	JRST L2
41200		JRST L9
41300		MOVE	T,.COMM.+1	;IF(JA.EQ.44)RETURN
41400		CAIN	T,=44		;WON'T LOOK AT BARLINES FOR HEIGHT.
41500		JRA	16,3(16)
41600		MOVE	T,@1(16)
41700		CAMG	T,DPY+1
41800		JRST	L333
41900		MOVEM	T,DPY+1  ;  IF(B.LT.BOT)BOT=B
42000		JRA	16,3(16)
42100	L333:	CAMG	T,DPY+2
42200		MOVEM	T,DPY+2
42300		JRA	16,3(16)  ;	IF(B.GT.TOP)TOP=B
42400				;2	IF(IPLT.EQ.-2)RETURN
42500	;;L2:   	MOVNI T,2
42600	;;	CAMN T,PLTR
42700	;;	JRA 16,3(16)
42800				;9	M=ROFF(A*DIS)
42900	L9:   	MOVE M,@(16)
43000		FMPR M,PLTR+2
43100		SKIPGE M
43200		FADR M,[-=1.0]
43300		FADR M,[=0.5]
43400		FIXX(M)
43500		MOVEM M,MM#
43600				;	N=ROFF(B*RHT)
43700		MOVE NZ,@1(16)
43800		FMPR NZ,PLTR+1
43900		SKIPGE NZ
44000		FADR NZ,[-=1.0]
44100		FADR NZ,[=0.5]
44200		FIXX(NZ)
44300		MOVEM NZ,NN#
44400				;8	CALL PLOT(M,N,L)
44500	L8:	MOVE T,@2(16)
44600		MOVEM T,LL#
44700		JSA 16,PLOT
44800		JUMP MM
44900		JUMP NN
45000		JUMP LL
45100				;	END
45200		JRA 16,3(16)
45300	
51600	PLOTS:	0
51700		JRA	16,1(16)	; DUMMY ROUTINE
51800	
51900	J←10↔ A←2↔ B←3↔ C←4↔ D←5↔ E←6↔ NQ←11↔NX←12 ; SUBROUTINE NOIR(RMINI)
52000	Y←13↔ X←14↔ L←15↔ M←1
52100	JPOS:	0		;C  BLACKS IN NOTES
52200	IPOS:	0	;COMMON R2,JA,CENTR,J2,RJQ(20),JQ(12),B,C,KC,D,N,JY,M,L
52300	IC:	0
52400	KZ:	0
52500	NOIR:	0    ;	COMMON/PLTR/IPLT,RHT,DIS /XRN/IRN(4000)
52600		MOVE	A,.COMM.+4		;EQUIVALENCE (PRE,IRN(1))
52700		FMPR	A,PLTR+2	;DATA BL/7.5/,BH/6.7/
52800	;  ADJUST BH AND FL FOR HEIGHT OF NOTE AND 'WIDTH'
52900		JSA	16,ROFF		;IPOS=ROFF(RJQ(1)*DIS)
53000		JUMP	A
53100		FIXX(A)
53200		MOVEM	A,IPOS
53300		MOVE	A,.COMM.+2		;JPOS=ROFF(CENTR*RHT)
53400		FMPR	A,PLTR+1
53500		JSA	16,ROFF
53600		JUMP	A
53700		FIXX(A)	
53800	;??	MOVE 	D,@(16)
53900	;??	CAME	D,STF+8		;IF(RMINI.NE.RSTJ2)JPOS=JPOS+1
54000	;??	AOS A	;TO PUSH MINI-NOTE UP ONE XGP NOTCH!!!! *******************
54100		MOVEM	A,JPOS		;SAVE FOR LATER
54200		MOVN	A,@(16)		;IF(-RMINI.EQ.PRE)GO TO 10
54300		CAMN	A,XRN
54400		JRST	NO10
54500		MOVEM	A,XRN		;PRE=-RMINI
54600		MOVE	D,[=0.25]	;D=.25
54700		MOVE	B,[=6.7]	;B=BH*RMINI*RHT
54800		FMPR	B,PLTR+1
54900		FMPR	B,@(16)
55000		MOVE	E,PLTR+2	;E=RMINI*DIS
55100		FMPR	E,@(16)
55200		MOVE	A,[=7.5]	;A=BL*E
55300		FMPR	A,E
55400		MOVE	15,A
55500		FIXX(15)		;IC=A
55600		MOVEM	15,IC
55700		FMPR	A,A		;A=A*A
55800		MOVN	E,B		;E=-B/4.
55900		FDVR	E,[=4.0]
56000		MOVE	15,B		;K=B
56100		FIXX(15)
56200		MOVEM	15,KZ
56300		FMPR	B,B		;B=B*B
56400	;  USES EQUATION FOR ELLIPSE
56500		MOVEI	11,1		;N=1
56600		MOVEI	NX,2		;NX=2
56700		MOVN	J,KZ	;6	DO 1 J=-K,K
56800	NO1:	MOVE	Y,J		;Y=J*J
56900		IMUL	Y,Y
57000		FLOAT(Y)   		;FLOAT
57100		MOVN	X,Y		;X=SQRT(A-(A*Y)/B)
57200		FMPR	X,A
57300		FDVR	X,B
57400		FADR	X,A
57500		JSA	16,SQRT
57600		JUMP	X
57700		MOVE	X,0
57800		MOVE	L,E		;L=E-X
57900		FSBR	L,X
58000		FIXX(L)
58100		MOVE	M,X		;M=X+E
58200		FADR	M,E
58300		FIXX(M)		;  THE TWO SIDES OF THE LINE
58400		SKIPGE	11		;IF(N)CALL EXCH(L,M)
58500		EXCH	L,M
58600		MOVEM L,XRN-1(NX)
58700		MOVEM M,XRN(NX)		;     C IS VERTICLE POS.
58800		ADDI	NX,2		;NX=NX+2
58900		FADR	E,D		;E=E+D    E IS TO TILT IT.
59000		MOVNS	11	;1	N=-N
59100		CAMGE	J,KZ
59200		AOJA	J,NO1		;LOOP BACK
59300	NO10:	MOVE	J,IPOS	;10	CALL PLOT(IPOS+3,JPOS,3)
59400		ADDI	J,3
59500		JSA	16,PLOT
59600		JUMP	J
59700		JUMP 	JPOS
59800		JUMP	[3]
59900		MOVEI	11,2		;N=2  1ST LOC. OF ARRAY HAS "PRE"
60000		MOVE	L,IC		;L=IPOS+IC
60100		ADD	L,IPOS
60200		MOVN	M,KZ		;DO 11 M=-K,K
60300	NO11:	MOVE	J,JPOS		;J=M+JPOS
60400		MOVEM	M,PLOTS
60500		ADD	J,M		;CALL PLOT(L+IRN(N),J,2)
60600		MOVE NX,XRN-1(11)
60700		ADD	NX,L
60800		JSA 	16,PLOT
60900		JUMP	NX
61000		JUMP	J
61100		JUMP	[2]	 	;CALL PLOT(L+IRN(N+1),J,2)
61200		MOVE NX,XRN(11)
61300		ADD	NX,L
61400		JSA	16,PLOT
61500		JUMP	NX
61600		JUMP	J
61700		JUMP	[2]
61800		ADDI	11,2		;11	N=N+2
61900		MOVE	M,PLOTS
62000		CAMGE	M,KZ
62100		AOJA	M,NO11
62200		JRA	16,1(16)
62300	
62400		END